perm filename CCRMA.CHG[NEW,LCS] blob
sn#573336 filedate 1981-03-17 generic text, type T, neo UTF8
*********** CHANGES SINCE MOVE TO CCRMA **********
NEWMRK.F4****************
[SUBROUTINE DASHES(IX,R2,RD)]
2 SZ=RN(J+5)
R5=SZ*RSTJ2
C R=REAL SIZE FACTOR FOR SPACE RN(LFT+9) IS WIDTH OF GROUP TO LEFT.
RP=R5*RN(J+9)+A
→→→ IF(RP.LT.0)RP=3.0
C RP=RIGHT SIDE OF LEFT CHAR. STRING.
R3=RP
→→→ IF(B.GT.201)B=201.
R6=B-R5*BSIZE
CC RR6=R6
→→→ IF(R3.LT.0)R3=4.
10 R6=R6-RDZ
CC10 R6=R3+(RR3+A)*B-RR3-RDZ
RD(6)=RR3
RD(7)=A/RSTJ2
C P9(SPACE BETWEEN DASHES) REAL SIZE IS P9*RSTJ2
CCC GO TO 4
CCC11 RD(5)=0
4 RD(2)=RN(J+4)+1.0-R5*0.5
SUBROUTINE CMDIN
C SAVES INPUT LINES WHEN 1ST CHAR. IS :
C OUTPUTS SAVED LINES WHEN 1ST CHAR. IS ;
COMMON /ALF/INP(72)
DIMENSION J(60)
EQUIVALENCE (I1,INP),(I2,INP(2)),(I3,INP(3))
DATA J/60*' '/
IF(I1.EQ.';')GO TO 11
C JUMP TO GET BACK COMMAND 1, 2 OR 3 (; ;; ;;;)
N=2
L=1
LL=1
10 NN=N+19
DO 2 K=N,NN
M=INP(K)
IF(M.EQ.':')GO TO 3
J(L)=M
2 L=L+1
IF(K.EQ.NN)GO TO 6
3 DO 5 KK=K,NN
J(L)=' '
5 L=L+1
4 IF(M.NE.':')GO TO 6
C 3 COMMANDS CAN BE GIVEN ON ONE LINE, EACH STARTS WITH :
C THE 1ST ONE WILL BE ACTIVATED IMMEDIATELY, OR BY TYPING ;
C THE 2ND AND 3RD ARE ACTIVATED BY TYPING ;; OR ;;;
C NO ERROR TRAP FOR MORE THEN 3 COLONS
LL=LL+20
L=LL
N=K+1
GO TO 10
6 N=1
9 NN=N+19
L=0
DO 7 K=N,NN
L=L+1
7 INP(L)=J(K)
DO 8 K=21,72
C CLEAR REST OF INP ARRAY
8 INP(K)=' '
RETURN
11 N=1
IF(I2.EQ.';')N=21
IF(I3.EQ.';')N=41
GO TO 9
C GO GET BACK COMMAND 1, 2 OR 3 (; ;; ;;;)
END
MS.F4****************
290 SCORE=-1
CQQ ACCEPT 89,INP
READ(IDEV,700,END=240)INP
IF(I1.EQ.LESS)GO TO 240
C '<' = TEMPORARY ESCAPE FROM 'FILE' MODE
IF(I1.NE.IGT)GO TO 300
C '>' = RETURN TO 'FILE' MODE - IF NOT STILL EDITING.
IF(X22.NE.0)GO TO 260
GO TO 230
300 IF(I1.EQ.':')CALL CMDIN
IF(I1.EQ.ISEMI)CALL CMDIN
C TYPE : AS FIRST ITEM TO SAVE COMMAND LINE. TYPE ; TO REPEAT IT.
CALL LULOOP
IF(IDEV.EQ.5)GO TO 320
IF(I7.NE.LTT)GO TO 320
IF(I1.NE.LCC)GO TO 320
C 'ET' DIRECTORY? UGH!!!
310 READ(IDEV,700)INP
→→→ 5 ,PLUS/'+'/,EXT/'MS '/,COMMA/','/,FILNAM/'INIT'/
DATA MKS/'W','A','F','S','M','T','D','U','H','I','P','C','R','O'/
710 IF(I2.NE.IXX)GO TO 715
C TYPE 'NX' TO RESTART WITH NEXT ALPHABETICAL FILE NAME (ONLY 5TH LETTER THOUGH.)
I1=LRR
I2=LSS
I4=PLUS
GO TO 10
715 IF(QUICK.NE.0)GO TO 720
IF(I2.NE.LDD)GO TO 1065
C FOR 'CD' CENTER DASHES
JJ2=1
GO TO 1785
1065 KNT=0
SCORE=0
1070 KNT=KNT+1
1230 R4=RZMY+R3
R3=RZMX
I1=0
C I1=0 STOPS REDRAWING OF SPACING SCALE FOR UP-DOWN ZOOMS
GO TO 1210
1310 R4=0
R2=0
IF(RZMSZ.LE.1)GO TO 1315
C PUT UP SPACING SCALE ABOVE STAFF 1 FOR ZOOMS .GT.1
C 2/81 IF(RZMSZ.LT.2)R2=1.
C NO***** SETS HEIGHT OF SPACE NUMS. DEPENDING ON ZOOM FACTOR
R2=1
IF(I1.NE.0)CALL SCL
R2=0
1315 R3=0
R4=0
LCEN=0
MCEN=0
C IF P5 ≠ 0 GOES THROUGH DATA IN OLD WAY.
JFONT=0
1320 M=1
1770 IF(I2.EQ.IBLA)GO TO 1780
IF(I2.EQ.LDD)GO TO 1060
C NOW 'CD', WHEN NOT IN EDIT MODE = CENTER ALL DASHES ON A LINE. (USES GRED)
1780 CALL MOVER
IF(R2.GE.99)GO TO 260
C 99(+)=BACKUP OUT OF MOVER ETC.
JFONT=0
1785 IGO=0
C SO IT WON'T DO ALL FONT LOOKUPS.
1790 IF(JJ2)GO TO 130
2240 IF(K.NE.PLUS)GO TO 2245
C NOW NEXT-TO-LAST LETTER IS MOVED UP, LAST LETTER IS RESET TO 'A'
NAME=((NAMZ+256).AND."777777777400).OR."202
C .AND.ETC ZEROS LAST 8 BITS, .OR."202 PUTS IN 'A'
NAMZ=NAME
K=0
GO TO 2265
2245 CALL TYPSTR(' NAME.EXT? ')
READ(IDEV,700,END=240)INP
C GO PUT A1'S INTO A5, ETC.
CALL NAMEXT(INP,NAME,EXT)
IF(NAME.EQ.IBLA)GO TO 2270
IF(NAME.NE.'99')GO TO 2250
C TYPE '99' TO BACK OUT OF 'SAVE'.
NAME=L
EXT=X
GO TO 130
2250 IF(I1.NE.LESS)GO TO 2260
IDEV=5
GO TO 2240
2260 CALL LO2UP(NAME)
CALL LO2UP(EXT)
K=NAME
IF(NAME.EQ.PLUS)NAME=NAMZ+2
C NAME='+' WHEN "NX" HAS BEEN TYPED. (UPS LAST LETTER OF FIVE TO NEXT)
2265 IF(LOOKX(NAME,EXT).EQ.0)GO TO 2240
C FUNC. LOOKD IS 'FAIL' PROG. TO CHECK ON LOOKUPS
2270 JA=-1
2260 CALL LO2UP(NAME)
CALL LO2UP(EXT)
IF(NAME.EQ.PLUS)NAME=NAMZ+2
2290 K=NAME
NAMZ=K
C SAVE THE NAME FOR '+' ROUTINE (GOES UP THE ALPHABET)
IF(LOOKX(NAME,EXT).EQ.0)GO TO 2240
→→→ NAMZ=L
2310 RSTF=0
SLOOP.FAI****************
SLOOP: 0
→→→ SETZM CIX ;INITIALIZE HALF-SLUR FLAG
LOOP.FAI****************
BOX: 0 ;CALL BOX(I,R) SEE PLTSRT.F4 FOR FORTR. VERSION
MOVE IDEV
CAIE 5
JRST BX4-3 ;UPDATE IOLD JRA 16,2(16) ;IF(IDEV.NE.5)RETURN
WORDS.F4****************
1 J4,L,Y,K,RX,RZ,RA,J5 /XRN/RN(1) /ALF/INP(1) /IDEV/IDEV
C12/80 1 J4,L,Y,K,RX,RZ,RA,J5 /XRN/RN(1) /ALF/INP(72),ML
431 FORMAT(100A1)
IF(IDEV.NE.5)GO TO 131
231 IDEV=5
CALL TYPSTR('TYPE UP TO 100 CHARS--')
CALL TYPCRL
131 READ(IDEV,431,END=231)(INP(KN),KN=1,100)
C12/80 131 CALL TYPE
C12/80 531 DO 31 KN=72,1,-1
C NOW 100 CHARACTERS ACCPTED IN 'TYPE' MODE
531 DO 31 KN=100,1,-1
317 ML=L
DO 417 N=IA,KN
C12/80 IF(ML.LT.72)ML=ML+1
IF(ML.LT.100)ML=ML+1
IF(J2.GT.7)RETURN
C CATCH STAFF TYPO ERROR
KNT=-1
317 ML=L
DO 417 N=IA,KN
→→→ IF(ML.LT.72)ML=ML+1
C MAKE ABOVE MORE 'ELEGANT'
SLRSCL.F4****************
SUBROUTINE SETLET
IF(IDEV.EQ.1)GO TO 44
CALL DPYSET(3,SU,320) [DELETE THESE ABOVE!!]
CALL DPYBRT(6)
DO 4 K=2,M
R3=RHORZ(RPOS(1,K))
CALL PNUM
J5=J5+1
4 IF(J5.EQ.10)J5=0
CALL DPYOUT(3)
CALL SETPOG(1)
44 RPOS(1,M+1)=200
2267 IF(V(3).EQ.0.AND.IDEV.NE.1)GO TO 267
C WHEN TYPING, NOTE NUMS CAN BE ON 1 LINE IF THERE ARE >2. (VERT. POS. MUST BE PRESET)
BEAMS.F4*****************
SUBROUTINE BMREAD
COMMON /ALF/INP(72) /IDEV/IDEV
CALL TYPE
C12/80 IF(IDEV.EQ.5)WRITE(21,4501)INP
IF(IDEV.EQ.5)CALL INPOUT
C WRITES OUT INPUT LINE.
SCMSS.F4********************
11 RB=0
IF(MODE.LE.2)GO TO 111
IF(IDEV.NE.5)GO TO 111
C SKIP IF READING AN EDIT FILE
3377 CALL OFILE(21,NAMSC)
C12/80 WRITE(21,2114)INP
CALL INPOUT
C WRITE OUT 'IN' ETC.
IF(IDEV.EQ.5)CALL INPOUT
C12/80 IF(IDEV.EQ.5)WRITE(21,2114)INP
C WRITE OUT SPACING INFO
5333 CALL A2READ(K,RA)
80041 IF(IDEV.EQ.5)CALL INPOUT
C12/80 80041 IF(IDEV.EQ.5)WRITE(21,2114)INP
IF(IDEV.EQ.5)CALL INPOUT
C12/80 IF(IDEV.EQ.5)WRITE(21,2114)INP
CALL LULOOP
77732 CALL LNEND
RHYTH.F4 *********************
(SUBROUTINE NOTNUM)
CALL DPYSET(3,ST(3200),390)
C LOCATION 3200 IN ST COULD BE IN USE IF MUCH DATA ON SCREEN. (DOESN'T MATTER)
GREDX.F4*************
SUBROUTINE GRED
COMMON /MKX/KSLA,ISEMI,LESS,IGT
1/A2Z/LAA,LBB,LCC,LDD,NONO(7),LEL,LMM,LNN,NON(9),LXX
4 JA=98
C DEL=FOR DELETIONS CD=CENTER DASHES BETWEEN SYLLABLES.
IF(I2.EQ.LDD)JA=0
IF(I2.NE.LDD)GO TO 71
C NEXT FOR 'CD' CENTER DASHES WITH TEXT
IF(RB.NE.4.)GO TO 6
IF(RN(JY).LT.8.)GO TO 6
C P10 MUST BE .GT.0
CALL DASHES(ITEM,RN(JY+2),RN(JY+3))
GO TO 6
71 IF(V(1).EQ.12)GO TO 77
IF(V(1).EQ.100)GO TO 341
C USE P100 AND ANY CODE# TO CREATE CUES. I.E. MINI NOTES, RESTS, BEAMS.
IF(RC.EQ.999)GO TO 143
C USE P12 TO INVERT STEM, BEAM AND SLURS ALL AT ONCE.
C SET 12 TO 1 WITH CODE 5 TO INVERT SLURS ONLY
77 RC=0
IF(RB.EQ.5)GO TO 141
IF(RB.NE.6)GO TO 143
IF(RX.EQ.1)GO TO 141
143 IF(RX.NE.44.)GO TO 144
C USE CODE 44 FOR ALL 'LINE' EXCEPT BARLINES.
IF(RB.NE.4)GO TO 6
IF(RN(JY).LE.2)GO TO 6
GO TO 100
144 IF(RB.NE.RX.AND.RX.NE.0)GO TO 6
CXX IF(ASK)GO TO 100
CXX CALL ASKIT
CXX IF(K.EQ.LNN)GO TO 6
CXX IF(K.EQ.LXX)GO TO 19
100 IF(INP(1).EQ.LAA)GO TO 141
****** JUSTFY.F4
IF(RN(L+8).NE.0)GO TO 250
C P8=-1 MEANS WHOLE MEASURE REST (NEVER DOT, P6 CAN HAVE NUMB.)
C P8=POS MEANS WHOLE MEASURE REST WITH NUMBER.
44 IF(RL.GE.4)RB=RN(L+6)*1.5
******* JUST.F4
1 FORMAT(' INPUT NAME.EXT 1? '$)
3011 FORMAT(' TYPE OUTPUT NAME.EXT 1 -- '$)
TYPE 60,NM,OUTX
60 FORMAT(1XA5,'.',A3)
CODE4.FAI**********
SKIPG .COMM.+=10 ; 26420 IF(R9.LE.0)RZ=RJ
MOVEM 02,ALF+=18
;26430 P9 SETS SPACE BETWEEN DASHES. (CAN BE DIFFERENT FROM P8)
PAGE*******
SEE NEW SUBROUTINE READX (AND OTHERS) AT END OF PAGE.F4
TRNSP.F4*********
1002 RT=0
IF(ITR.EQ.0)RETURN
RT=RTR(ITR)
C EEb,EE,F-,F#-,G, Ab,A,Bb,B,DMY, Db,D,Eb,E,F,G↑ BBb, 8-, 8↑
IF(SIG.NE.-99)GO TO 199
C FOUND KSIG, SO DON'T DO THE REST
IF(XSIG.NE.0)GO TO 2002
41 NSIG=-1
SUBR. RVRS
CCC IF(Q(J+5).LT.10)GO TO 10
IF(Q(J+5).LT.10)GO TO 202
C JUMP IF NO STEM ON IT
IF(Q(J+8).GT.999.)GO TO 202
B=Q(J)
IF(B.GT.7.AND.Q(J+10).NE.0)GO TO 202
C JUMP IF GRACE NOTE (P8=1000 OR P10=-1) OR ON ANOTHER STAFF.
IF(B.GT.6.AND.Q(J+9).LT.0)GO TO 202
C SKIP NOTES WITH NO LEDGER LINES
KK=K+1
3 IF(KK.GT.LEND)GO TO 102
********* PLOT3.FAI *********
PL1: MOVE 4,LX
. . . .
MOVE 7,4 ;AC5 HAS REMAINDER
SKIPE 5 ;DON'T SUBTRACT IF AC5 IS ALREADY 0
SOJ 5, ;LESS 1 BECAUSE . . . . .